(ql:quickload '(vecto))

(defun flatten (lst)
    (let ((res nil))
        (labels ((pusher (listic)
                     (dolist (elm listic)
                         (if (atom elm)
                             (push elm res)
                             (pusher elm)))))
            (pusher lst))
        (nreverse res)))

(defun contanep (val list &key (test #'eql))
    (dolist (elm list)
        (when (funcall test elm val)
            (return-from contanep t)))
    nil)

(defun param-curve (a b d &rest functions)
  (loop for p from a to b by d
        collect (mapcar #'(lambda (fun)
			                  (funcall fun p))
		                functions)))

(defun line-bias (line &rest bias)
    (loop for coords in line
          collect (mapcar #'+ coords bias)))

(defun scale (line &rest scales)
    (loop for coords in line
          collect (mapcar #'* coords scales)))

(defstruct figure
  color
  coords
  scale
  type
  parameters)

(defun figure-line (figure)
    (cond ((eql (figure-type figure) :parametric)
           (apply #'line-bias (apply #'scale (apply #'param-curve
					                                (figure-parameters figure))
			                         (figure-scale figure))
	              (figure-coords figure)))

          ((eql (figure-type figure) :line-defined)
           (apply #'line-bias (apply #'scale (figure-parameters figure)
			                         (figure-scale figure))
	              (figure-coords figure)))))

(defun closedp (figure)
    (if (listp (figure-type figure))
        (contanep :closed (figure-type figure))
        (eql :closed (figure-type figure))))


(defun paint-figure (figure)
    (let ((line (figure-line figure)))
        (vecto:move-to (first  (car line))
                       (second (car line)))
        (loop for coords in (cdr line) do
              (vecto:line-to (first  coords)
                             (second coords)))
;        (when (closedp figure) ; АХТУНГ! Перестало работать, когда я добавил эту строчку
;            (vecto:close-subpath))
        (vecto:stroke)))

;************************************************************
;*                   Генераторы фигур                       *
;************************************************************

; Следующие функции создат фигуры с задаными параметрами
(defun butterfly (scale x y &key (d 0.01) (min 0) (max (* 12 pi)))
    (make-figure :coords (list x y)
                 :scale  (list scale (- 0 scale))
                 :type :parametric
                 :parameters (list min
                                   max
                                   d
                                   #'(lambda (p)
                                         (* (sin p)
                                            (- (exp (cos p))
                                               (* 2 (cos (* 4 p)))
                                               (expt (sin (/ p 12)) 5))))

                                   #'(lambda (p)
                                         (* (cos p)
                                            (- (exp (cos p))
                                               (* 2 (cos (* 4 p)))
                                               (expt (sin (/ p 12)) 5)))))))


(defun lissajous (width height kx ky bias x y &key (d 0.01) (min 0) (max (* 2 pi)))
    (make-figure :coords (list x y)
	             :scale  (list 1 1)
                 :type :parametric
	             :parameters (list min
				                   max
				                   d
				                   #'(lambda (p)
				                         (* (/ width 2) (cos (+ (* kx p) bias))))
				                   #'(lambda (p)
				                         (* (/ height  2) (sin (* ky p)))))))



(defun elipse (width height x y &key (d 0.01) (min 0) (max (* 2 pi)))
    (lissajous width height 1 1 0 x y :d d :min min :max max))

(defun circle (radiuse x y &key (d 0.01) (min 0) (max (* 2.1 pi)))
    (elipse (* 2 radiuse) (* 2 radiuse) x y :d d :min min :max max))

(defun rectangle (width height x y)
    (make-figure :coords (list x y)
                 :scale  (list width height)
                 :type '(:line-defined :closed)
                 :parameters '((0 0) (1 0) (1 1) (0 1) (0 0))))

(defun command-interpretator (command-exp)
    (let ((command   (first command-exp))
          (arguments (rest  command-exp)))
        (case command
          ((line-width)
           (apply #'vecto:set-line-width arguments))
          
          ((line-color)
           (if (= (length arguments) 4)
               (apply #'vecto:set-rgba-stroke arguments)
               (apply #'vecto:set-rgb-stroke  arguments)))
          
          ((fone-color)
           (if (= (length arguments) 4)
               (apply #'vecto:set-rgba-fill arguments)
               (apply #'vecto:set-rgb-fill arguments))
           (vecto:clear-canvas))
          
          ((exec-commands)
           (loop for fun in arguments
                 do (apply #'funcall (symbol-function (first fun))
                           (rest fun)))))))

(defun render (width height file &rest figures-and-control)
    (vecto:with-canvas (:width width :height height)
        (loop for elm in figures-and-control do
          (when (figure-p elm)
              (paint-figure elm))
          (when (listp elm)
              (command-interpretator elm)))
        (vecto:save-png file)))

;Пример:
(render 600 600 "~/testimg.png"
        '(line-width 50)
        '(line-color 255 0 0)
        (circle 277 300 300)
        '(line-width 20)
        '(line-color 0 255 0)
        (lissajous 382 382 3 4 (/ pi 2) 300 300))

(defun embleme ()
    (vecto:with-canvas (:width 800 :height 800)
        (vecto:set-rgb-fill 255 255 255)
        (vecto:clear-canvas)

        (vecto:set-rgb-stroke 255 0 0)
        (vecto:set-line-width 60)
        (paint-figure (circle 380 400 400))

        (vecto:set-rgb-stroke 0 255 0)
        (vecto:set-line-width 30)
        (paint-figure (lissajous 540 540 3 4 (/ pi 2) 400 400))

        (let ((font (vecto:get-font "times.ttf")))
            (vecto:set-font font 100)
            (vecto:draw-centered-string 400 390 #(#x3BB)))
        
        (vecto:save-png "~/embleme.png")))

